home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol160 / updatper.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-12-16  |  12.1 KB  |  461 lines
  1. 90  WIDTH "scrn:", 80
  2. 95  SCREEN 0,1,0,0
  3. 100  TITLE$ = "Update the Persons File Program"
  4. 105  TITLE$ = TITLE$ + " ON DISPLAY"
  5. 110  VERSION$ = "Version 3.1"
  6. 115  COPY1$ = "Copyright (c) 1983, 1984, 1985, by:"
  7. 120  COPY2$ = "Melvin O. Duke"
  8. 125  PRICE$ = "$35"
  9. 130  ADDR1$ = "Melvin O. Duke"
  10. 135  ADDR2$ = "P. O. Box 20836"
  11. 140  ADDR3$ = "San Jose, CA  95160"
  12. 145  REM Dimension Statements go here
  13. 170  REM Produce the first screen
  14. 175  KEY OFF : CLS
  15. 180  REM Draw the outer double box
  16. 185  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  17. 190  REM Find the title location
  18. 195  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  19. 200  REM Draw the title box
  20. 205  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  21. 210  REM Print the title
  22. 215  LOCATE 4,TITLE.POS : PRINT TITLE$
  23. 220  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  24. 225  REM Draw the Contribution box
  25. 230  R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  26. 235  REM Request the Contribution
  27. 240  LOCATE 9,23 : PRINT "If you are using these programs, and"
  28. 245  LOCATE 10,21 : PRINT "finding them of value, your contribution"
  29. 250  LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
  30. 255  REM Draw the Mailing Label
  31. 260  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  32. 265  REM Print the Name and Address
  33. 270  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  34. 275  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  35. 280  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  36. 285  REM Draw the Copyright box
  37. 290  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 400
  38. 295  REM Print the Copyright
  39. 300  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  40. 305  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  41. 310  GOTO 740
  42. 400  REM subroutine to print a double box
  43. 405  COLOR 5
  44. 410  FOR I = R1 + 1 TO R2 - 1
  45. 420   LOCATE I, C1 : PRINT CHR$(186);
  46. 430   LOCATE I, C2 : PRINT CHR$(186);
  47. 440  NEXT I
  48. 450  FOR J = C1 + 1 TO C2 - 1
  49. 460   LOCATE R1, J : PRINT CHR$(205);
  50. 470   LOCATE R2, J : PRINT CHR$(205);
  51. 480  NEXT J
  52. 490   LOCATE R1, C1 : PRINT CHR$(201);
  53. 500   LOCATE R1, C2 : PRINT CHR$(187);
  54. 510   LOCATE R2, C1 : PRINT CHR$(200);
  55. 520   LOCATE R2, C2 : PRINT CHR$(188);
  56. 525  COLOR 7
  57. 530  RETURN
  58. 600  REM subroutine to print a single box
  59. 605  COLOR 3
  60. 610  FOR I = R1 + 1 TO R2 - 1
  61. 620   LOCATE I, C1 : PRINT CHR$(179);
  62. 630   LOCATE I, C2 : PRINT CHR$(179);
  63. 640  NEXT I
  64. 650  FOR J = C1 + 1 TO C2 - 1
  65. 660   LOCATE R1, J : PRINT CHR$(196);
  66. 670   LOCATE R2, J : PRINT CHR$(196);
  67. 680  NEXT J
  68. 690   LOCATE R1, C1 : PRINT CHR$(218);
  69. 700   LOCATE R1, C2 : PRINT CHR$(191);
  70. 710   LOCATE R2, C1 : PRINT CHR$(192);
  71. 720   LOCATE R2, C2 : PRINT CHR$(217);
  72. 725  COLOR 7
  73. 730  RETURN
  74. 740  REM ask user to press a key to continue
  75. 750  LOCATE 25,1
  76. 760  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  77. 770  K$ = INKEY$ : IF K$ = "" THEN 770
  78. 780  CLS
  79. 840  CLS
  80. 1000  REM Update the Persons File Program.
  81. 1010  REM By:  Melvin O. Duke.  Last Updated 3 September 1985.
  82. 1020  OPEN "a:persfile" AS #1 LEN = 256
  83. 1030  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  84. 1040  REM ask the user for input
  85. 1045  LOCATE 23,1 : PRINT SPACE$(79);
  86. 1050  LOCATE 23,1 : PRINT "(0 to quit, ? to locate unused record)";
  87. 1060  LOCATE 22,1 : PRINT SPACE$(79) : LOCATE 22,1
  88. 1070  INPUT "Enter Record Number of Person to Update"; REPLY$
  89. 1071  IF REPLY$ <> "?" THEN 1088
  90. 1072  REM Locate an unused record
  91. 1073  FOUND = 0 : IF REC.NO = 0 THEN REC.NO = 1
  92. 1074  FOR LOOK = REC.NO TO 500
  93. 1075   GET #1, LOOK
  94. 1076   LOCATE 15,1 : PRINT "Searching Record";LOOK;
  95. 1077   T1 = CVS(F1$)
  96. 1078   IF T1 > 0 THEN 1080
  97. 1079   FOUND = 1 : REC.NO = LOOK : LOOK = 500
  98. 1080  NEXT LOOK
  99. 1081  IF FOUND = 1 THEN 1110
  100. 1082  PRINT "Unable to find an unused record above record";REC.NO
  101. 1083  PRINT "Either start from record 1 or extend the file"
  102. 1084  PRINT "Press any key to continue"
  103. 1085  A$ = INKEY$ : IF A$ = "" THEN 1085
  104. 1086  GOTO 1040
  105. 1088  REC.NO = VAL(REPLY$)
  106. 1089  IF REC.NO = 0 THEN 4080
  107. 1090  IF REC.NO < 1 OR REC.NO > 500 THEN 1040
  108. 1100  GET #1, REC.NO
  109. 1110  REM Extract information from the file for use
  110. 1120  T1 = CVS(F1$)
  111. 1121  REM Disallow Update if Rec.no is Zero (never Created)
  112. 1122  IF T1 <> 0 THEN 1130
  113. 1123  LOCATE 22,1 : PRINT SPACE$(79);: LOCATE 23,1 : PRINT SPACE$(79);: LOCATE 22,1
  114. 1125  PRINT "Record Number is Zero.  Must run the CREATPER Program First."
  115. 1126  LOCATE 25,1 : PRINT "Press any key to continue";
  116. 1127  A$ = INKEY$ : IF A$ = "" THEN 1127
  117. 1128  GOTO 4080  'Close the Files and return to the Menu
  118. 1130  T2$ = F2$
  119. 1140  T3$ = F3$
  120. 1150  FOR J = 1 TO LEN(F3$)-1
  121. 1160   IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  122. 1170  NEXT J
  123. 1180  T4$ = F4$
  124. 1190  IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  125. 1200  IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  126. 1210  T5 = CVS(F5$)
  127. 1220  T6 = CVS(F6$)
  128. 1230  T7 = CVS(F7$)
  129. 1240  T8$ = F8$
  130. 1250  T9$ = F9$
  131. 1260  T10$ = F10$
  132. 1270  T11$ = F11$
  133. 1280  T12$ = F12$
  134. 1290  T13$ = F13$
  135. 1300  T14$ = F14$
  136. 1310  T15$ = F15$
  137. 1320  T16$ = F16$
  138. 1330  T17$ = F17$
  139. 1340  T18$ = F18$
  140. 1350  T19$ = F19$
  141. 1360  CLS
  142. 1370  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
  143. 1380  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2100  'Horizontal double
  144. 1390  LOCATE 2,3 : PRINT "Personal Information for:"
  145. 1400  R1 = 3 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 2240  'Vertical Double
  146. 1410  LOCATE 4,3 : COLOR 1 : PRINT "Person:"; : COLOR 6
  147. 1420  LOCATE 6,3 : PRINT "Record-Number:";
  148. 1430  LOCATE 8,3 : PRINT "Surname:";
  149. 1440  LOCATE 9,3 : PRINT "Given-names:";
  150. 1450  LOCATE 11,3 : PRINT "Sex:";
  151. 1460  LOCATE 12,3 : PRINT "Code:";
  152. 1470  R1 = 13 : C1 = 1 : R2 =13 : C2 = 40 : GOSUB 2100  'Horizontal Double
  153. 1480  LOCATE 14,3 : COLOR 1 : PRINT "Person's Father:"; : COLOR 6
  154. 1490  LOCATE 16,3 : PRINT "Father's Record-number:";
  155. 1500  R1 = 17 : C1 = 1 : R2 = 17 : C2 = 40 : GOSUB 2170  'Horizontal Single
  156. 1510  LOCATE 18,3 : COLOR 1 : PRINT "Person's Mother:"; : COLOR 6
  157. 1520  LOCATE 20,3 : PRINT "Mother's Record-number:";
  158. 1530  LOCATE 4,42 : COLOR 1 : PRINT "Person's Vital Statistics:"; : COLOR 6
  159. 1540  LOCATE 6,42 : PRINT "Birth-date:";
  160. 1550  LOCATE 7,42 : PRINT "Birth-city:";
  161. 1560  LOCATE 8,42 : PRINT "Birth-county:";
  162. 1570  LOCATE 9,42 : PRINT "State/Country:";
  163. 1580  LOCATE 11,42 : PRINT "Death-date:";
  164. 1590  LOCATE 12,42 : PRINT "Death-city:";
  165. 1600  LOCATE 13,42 : PRINT "Death-county:";
  166. 1610  LOCATE 14,42 : PRINT "State/Country:";
  167. 1620  LOCATE 16,42 : PRINT "Burial-date:";
  168. 1630  LOCATE 17,42 : PRINT "Burial-city:";
  169. 1640  LOCATE 18,42 : PRINT "Burial-county:";
  170. 1650  LOCATE 19,42 : PRINT "State/Country:";
  171. 1660  GOSUB 1680 'To print the current information
  172. 1670  GOTO 2380 'For User Input
  173. 1680  REM Print the Information Currently Present
  174. 1690  LOCATE 2,29 : PRINT SPACE$(50);
  175. 1700  LOCATE 2,29 : COLOR 7 : PRINT T3$ + " " + T2$;
  176. 1710  LOCATE 6,18 : PRINT SPACE$(5);
  177. 1720  LOCATE 6,18 : COLOR 2 : PRINT T1;
  178. 1730  LOCATE 8,18 : PRINT SPACE$(20);
  179. 1740  LOCATE 8,18 : PRINT T2$;
  180. 1750  LOCATE 9,18 : PRINT SPACE$(22);
  181. 1760  LOCATE 9,18 : PRINT T3$;
  182. 1770  LOCATE 11,18 : PRINT SPACE$(7);
  183. 1780  LOCATE 11,18 : PRINT T4$;
  184. 1790  LOCATE 12,9 : PRINT SPACE$(5);
  185. 1800  LOCATE 12,9 : PRINT T5;
  186. 1810  LOCATE 16,27 : PRINT SPACE$(5);
  187. 1820  LOCATE 16,27 : PRINT T6;
  188. 1830  LOCATE 20,27 : PRINT SPACE$(5);
  189. 1840  LOCATE 20,27 : PRINT T7;
  190. 1850  LOCATE 6,57 : PRINT SPACE$(11);
  191. 1860  LOCATE 6,57 : PRINT T8$;
  192. 1870  LOCATE 7,57 : PRINT SPACE$(18);
  193. 1880  LOCATE 7,57 : PRINT T9$;
  194. 1890  LOCATE 8,57 : PRINT SPACE$(16);
  195. 1900  LOCATE 8,57 : PRINT T10$;
  196. 1910  LOCATE 9,57 : PRINT SPACE$(16);
  197. 1920  LOCATE 9,57 : PRINT T11$;
  198. 1930  LOCATE 11,57 : PRINT SPACE$(11);
  199. 1940  LOCATE 11,57 : PRINT T12$;
  200. 1950  LOCATE 12,57 : PRINT SPACE$(18);
  201. 1960  LOCATE 12,57 : PRINT T13$;
  202. 1970  LOCATE 13,57 : PRINT SPACE$(16);
  203. 1980  LOCATE 13,57 : PRINT T14$;
  204. 1990  LOCATE 14,57 : PRINT SPACE$(16);
  205. 2000  LOCATE 14,57 : PRINT T15$;
  206. 2010  LOCATE 16,57 : PRINT SPACE$(11);
  207. 2020  LOCATE 16,57 : PRINT T16$;
  208. 2030  LOCATE 17,57 : PRINT SPACE$(18);
  209. 2040  LOCATE 17,57 : PRINT T17$;
  210. 2050  LOCATE 18,57 : PRINT SPACE$(16);
  211. 2060  LOCATE 18,57 : PRINT T18$;
  212. 2070  LOCATE 19,57 : PRINT SPACE$(16);
  213. 2080  LOCATE 19,57 : PRINT T19$; : COLOR 7
  214. 2090  RETURN
  215. 2100  REM Subroutine to draw a double horizontal line.  Attach to double.
  216. 2105  COLOR 5
  217. 2110  FOR J = C1 + 1 TO C2 - 1
  218. 2120   LOCATE R1,J : PRINT CHR$(205);
  219. 2130  NEXT J
  220. 2140  LOCATE R1,C1 : PRINT CHR$(204);
  221. 2150  LOCATE R1,C2 : PRINT CHR$(185);
  222. 2155  COLOR 7
  223. 2160  RETURN
  224. 2170  REM Subroutine to draw a single horizontal line.  Attach to double.
  225. 2175  COLOR 5
  226. 2180  FOR J = C1 + 1 TO C2 - 1
  227. 2190   LOCATE R1,J : PRINT CHR$(196);
  228. 2200  NEXT J
  229. 2210  LOCATE R1,C1 : PRINT CHR$(199);
  230. 2220  LOCATE R1,C2 : PRINT CHR$(182);
  231. 2225  COLOR 7
  232. 2230  RETURN
  233. 2240  REM Subroutine to draw a double vertical line.  Attach to double.
  234. 2245  COLOR 5
  235. 2250  FOR I = R1 + 1 TO R2 - 1
  236. 2260   LOCATE I,C1 : PRINT CHR$(186);
  237. 2270  NEXT I
  238. 2280  LOCATE R1,C1 : PRINT CHR$(203);
  239. 2290  LOCATE R2,C1 : PRINT CHR$(202);
  240. 2295  COLOR 7
  241. 2300  RETURN
  242. 2310  REM Subroutine to draw a single vertical line.  Attach to double.
  243. 2315  COLOR 5
  244. 2320  FOR I = R1 + 1 TO R2 - 1
  245. 2330   LOCATE I,C1 : PRINT CHR$(179);
  246. 2340  NEXT I
  247. 2350  LOCATE R1,C1 : PRINT CHR$(209);
  248. 2360  LOCATE R2,C1 : PRINT CHR$(207);
  249. 2365  COLOR 7
  250. 2370  RETURN
  251. 2380  REM Routines to Obtain information from the User
  252. 2385  LOCATE 22,1 : PRINT SPACE$(79);
  253. 2386  LOCATE 23,1 : PRINT SPACE$(79);
  254. 2387  LOCATE 24,1 : PRINT SPACE$(79);
  255. 2388  LOCATE 25,1 : PRINT SPACE$(79);
  256. 2390  LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown.)";
  257. 2400  LOCATE 23,1
  258. 2410  INPUT "Enter the Record Number";REPLY$
  259. 2420  IF REPLY$ = "/" THEN 3750
  260. 2430  IF REPLY$ = "" THEN 2470
  261. 2440  IF ABS(VAL(REPLY$)) = ABS(T1) THEN 2450 ELSE 2441
  262. 2441  REM Prevent Change of Rec.no
  263. 2442  LOCATE 22,1 : PRINT SPACE$(79); : LOCATE 24,1 : PRINT SPACE$(79); : LOCATE 22,1
  264. 2443  PRINT "Cannot Change the Record Number to another number.";
  265. 2444  LOCATE 25,1 : PRINT "Press any key to continue";
  266. 2445  A$ = INKEY$ : IF A$ = "" THEN 2445
  267. 2446  GOTO 2380
  268. 2450  T1 = VAL(REPLY$)
  269. 2452  IF T1 < 1 THEN GOSUB 5000 : GOSUB 1680 : GOTO 3750  'Negative
  270. 2460  GOSUB 1680
  271. 2470  LOCATE 23,1 : PRINT SPACE$(79);
  272. 2475  REM Terminate record update if rec.no is negative
  273. 2476  IF T1 < 0 THEN 3750
  274. 2480  LOCATE 23,1
  275. 2490  INPUT "Enter the Person's Surname (all capital letters)";REPLY$
  276. 2500  IF REPLY$ = "/" THEN 3750
  277. 2510  IF REPLY$ = "" THEN 2540
  278. 2520  T2$ = REPLY$
  279. 2530  GOSUB 1680
  280. 2540  LOCATE 23,1 : PRINT SPACE$(79);
  281. 2550  LOCATE 23,1
  282. 2560  INPUT "Enter the Person's Given Names";REPLY$
  283. 2570  IF REPLY$ = "/" THEN 3750
  284. 2580  IF REPLY$ = "" THEN 2610
  285. 2590  T3$ = REPLY$
  286. 2600  GOSUB 1680
  287. 2610  LOCATE 23,1 : PRINT SPACE$(79);
  288. 2620  LOCATE 23,1
  289. 2630  INPUT "Enter the Person's Sex";REPLY$
  290. 2640  IF REPLY$ = "/" THEN 3750
  291. 2650  IF REPLY$ = "" THEN 2700
  292. 2660  T4$ = REPLY$
  293. 2670  IF LEFT$(REPLY$,1) = "m" OR LEFT$(REPLY$,1) = "M" THEN T4$ = "Male"
  294. 2680  IF LEFT$(REPLY$,1) = "f" OR LEFT$(REPLY$,1) = "F" THEN T4$ = "Female"
  295. 2690  GOSUB 1680
  296. 2700  LOCATE 23,1 : PRINT SPACE$(79);
  297. 2710  LOCATE 23,1
  298. 2720  INPUT "Enter the Person's Code";REPLY$
  299. 2730  IF REPLY$ = "/" THEN 3750
  300. 2740  IF REPLY$ = "" THEN 2770
  301. 2750  T5 = VAL(REPLY$)
  302. 2760  GOSUB 1680
  303. 2770  LOCATE 23,1 : PRINT SPACE$(79);
  304. 2780  LOCATE 23,1
  305. 2790  INPUT "Enter the Father's Record Number";REPLY$
  306. 2800  IF REPLY$ = "/" THEN 3750
  307. 2810  IF REPLY$ = "" THEN 2840
  308. 2820  T6 = VAL(REPLY$)
  309. 2830  GOSUB 1680
  310. 2840  LOCATE 23,1 : PRINT SPACE$(79);
  311. 2850  LOCATE 23,1
  312. 2860  INPUT "Enter the Mother's Record Number";REPLY$
  313. 2870  IF REPLY$ = "/" THEN 3750
  314. 2880  IF REPLY$ = "" THEN 2910
  315. 2890  T7 = VAL(REPLY$)
  316. 2900  GOSUB 1680
  317. 2910  LOCATE 23,1 : PRINT SPACE$(79);
  318. 2920  LOCATE 23,1
  319. 2930  INPUT "Enter the Person's Birth-date as: dd Mmm yyyy";REPLY$
  320. 2940  IF REPLY$ = "/" THEN 3750
  321. 2950  IF REPLY$ = "" THEN 2980
  322. 2960  RSET T8$ = REPLY$
  323. 2970  GOSUB 1680
  324. 2980  LOCATE 23,1 : PRINT SPACE$(79);
  325. 2990  LOCATE 23,1
  326. 3000  INPUT "Enter the Person's Birth-city";REPLY$
  327. 3010  IF REPLY$ = "/" THEN 3750
  328. 3020  IF REPLY$ = "" THEN 3050
  329. 3030  T9$ = REPLY$
  330. 3040  GOSUB 1680
  331. 3050  LOCATE 23,1 : PRINT SPACE$(79);
  332. 3060  LOCATE 23,1
  333. 3070  INPUT "Enter the Person's Birth-county";REPLY$
  334. 3080  IF REPLY$ = "/" THEN 3750
  335. 3090  IF REPLY$ = "" THEN 3120
  336. 3100  T10$ = REPLY$
  337. 3110  GOSUB 1680
  338. 3120  LOCATE 23,1 : PRINT SPACE$(79);
  339. 3130  LOCATE 23,1
  340. 3140  INPUT "Enter the Person's Birth-state or Country";REPLY$
  341. 3150  IF REPLY$ = "/" THEN 3750
  342. 3160  IF REPLY$ = "" THEN 3190
  343. 3170  T11$ = REPLY$
  344. 3180  GOSUB 1680
  345. 3190  LOCATE 23,1 : PRINT SPACE$(79);
  346. 3200  LOCATE 23,1
  347. 3210  INPUT "Enter the Person's Death-date as: dd Mmm yyyy";REPLY$
  348. 3220  IF REPLY$ = "/" THEN 3750
  349. 3230  IF REPLY$ = "" THEN 3260
  350. 3240  RSET T12$ = REPLY$
  351. 3250  GOSUB 1680
  352. 3260  LOCATE 23,1 : PRINT SPACE$(79);
  353. 3270  LOCATE 23,1
  354. 3280  INPUT "Enter the Person's Death-city";REPLY$
  355. 3290  IF REPLY$ = "/" THEN 3750
  356. 3300  IF REPLY$ = "" THEN 3330
  357. 3310  T13$ = REPLY$
  358. 3320  GOSUB 1680
  359. 3330  LOCATE 23,1 : PRINT SPACE$(79);
  360. 3340  LOCATE 23,1
  361. 3350  INPUT "Enter the Person's Death-county";REPLY$
  362. 3360  IF REPLY$ = "/" THEN 3750
  363. 3370  IF REPLY$ = "" THEN 3400
  364. 3380  T14$ = REPLY$
  365. 3390  GOSUB 1680
  366. 3400  LOCATE 23,1 : PRINT SPACE$(79);
  367. 3410  LOCATE 23,1
  368. 3420  INPUT "Enter the Person's Death-state or Country";REPLY$
  369. 3430  IF REPLY$ = "/" THEN 3750
  370. 3440  IF REPLY$ = "" THEN 3470
  371. 3450  T15$ = REPLY$
  372. 3460  GOSUB 1680
  373. 3470  LOCATE 23,1 : PRINT SPACE$(79);
  374. 3480  LOCATE 23,1
  375. 3490  INPUT "Enter the Person's Burial-date as: dd Mmm yyyy";REPLY$
  376. 3500  IF REPLY$ = "/" THEN 3750
  377. 3510  IF REPLY$ = "" THEN 3540
  378. 3520  RSET T16$ = REPLY$
  379. 3530  GOSUB 1680
  380. 3540  LOCATE 23,1 : PRINT SPACE$(79);
  381. 3550  LOCATE 23,1
  382. 3560  INPUT "Enter the Person's Burial-city";REPLY$
  383. 3570  IF REPLY$ = "/" THEN 3750
  384. 3580  IF REPLY$ = "" THEN 3610
  385. 3590  T17$ = REPLY$
  386. 3600  GOSUB 1680
  387. 3610  LOCATE 23,1 : PRINT SPACE$(79);
  388. 3620  LOCATE 23,1
  389. 3630  INPUT "Enter the Person's Burial-county";REPLY$
  390. 3640  IF REPLY$ = "/" THEN 3750
  391. 3650  IF REPLY$ = "" THEN 3680
  392. 3660  T18$ = REPLY$
  393. 3670  GOSUB 1680
  394. 3680  LOCATE 23,1 : PRINT SPACE$(79);
  395. 3690  LOCATE 23,1
  396. 3700  INPUT "Enter the Person's Burial-state or Country";REPLY$
  397. 3710  IF REPLY$ = "/" THEN 3750
  398. 3720  IF REPLY$ = "" THEN 3750
  399. 3730  T19$ = REPLY$
  400. 3740  GOSUB 1680
  401. 3750  REM Input is complete, now see if user wants to save the data
  402. 3760  LOCATE 24,1 : PRINT SPACE$(79);
  403. 3770  LOCATE 23,1 : PRINT SPACE$(79);
  404. 3780  LOCATE 23,1
  405. 3790  INPUT "Type s (save), m (more), or f (forget)";REPLY$
  406. 3800  IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 2380
  407. 3805  IF LEFT$(REPLY$,1) = "M" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 2380
  408. 3810  IF LEFT$(REPLY$,1) = "f" THEN CLS : GOTO 1040
  409. 3815  IF LEFT$(REPLY$,1) = "F" THEN CLS : GOTO 1040
  410. 3820  IF LEFT$(REPLY$,1) = "s" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 3850
  411. 3825  IF LEFT$(REPLY$,1) = "S" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 3850
  412. 3830  LOCATE 22,1 : PRINT "Error in reply";
  413. 3840  GOTO 3770
  414. 3850  REM Routine to SAVE the newly updated record
  415. 3860  LSET F1$  = MKS$(T1)
  416. 3870  LSET F2$  = T2$
  417. 3880  LSET F3$  = T3$
  418. 3890  LSET F4$  = LEFT$(T4$,1)
  419. 3900  LSET F5$  = MKS$(T5)
  420. 3910  LSET F6$  = MKS$(T6)
  421. 3920  LSET F7$  = MKS$(T7)
  422. 3930  RSET F8$  = T8$
  423. 3940  LSET F9$  = T9$
  424. 3950  LSET F10$  = T10$
  425. 3960  LSET F11$  = T11$
  426. 3970  RSET F12$  = T12$
  427. 3980  LSET F13$  = T13$
  428. 3990  LSET F14$  = T14$
  429. 4000  LSET F15$  = T15$
  430. 4010  RSET F16$  = T16$
  431. 4020  LSET F17$  = T17$
  432. 4030  LSET F18$  = T18$
  433. 4040  LSET F19$  = T19$
  434. 4050  PUT #1, REC.NO
  435. 4060  CLS
  436. 4070  GOTO 1040
  437. 4080  CLOSE #1
  438. 4090  CLS : LOCATE 21,1
  439. 4100  PRINT "End of Program"
  440. 4110  RUN "a:menu"
  441. 5000  REM Blank out a negative record
  442. 5020  T2$ = ""
  443. 5030  T3$ = ""
  444. 5040  T4$ = ""
  445. 5050  T5 = 0
  446. 5060  T6 = 0
  447. 5070  T7 = 0
  448. 5080  T8$ = ""
  449. 5090  T9$ = ""
  450. 5100  T10$ = ""
  451. 5110  T11$ = ""
  452. 5120  T12$ = ""
  453. 5130  T13$ = ""
  454. 5140  T14$ = ""
  455. 5150  T15$ = ""
  456. 5160  T16$ = ""
  457. 5170  T17$ = ""
  458. 5180  T18$ = ""
  459. 5190  T19$ = ""
  460. 5200  RETURN
  461.